home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
Help
/
Help Files
/
Compilation
/
Thunks
< prev
Wrap
Text File
|
1994-06-24
|
4KB
|
129 lines
;••• Thunks •••
(define (thunk? x) (and (cons? x) (eq? (0 x) 'thunk)))
(defmacro (info th)
`(1 ,th))
(defmacro (code th)
`(2 ,th))
(defmacro (source th)
`(3 ,th))
;pour le moment, les infos sont limitées à
;necessaires modifié strict(nec mod str)
(defmacro (minfo n m s)
`(cell ,n ,m ,s))
(defmacro (nec th)
`(0 (info ,th)))
(defmacro (mod th)
`(1 (info ,th)))
(defmacro (str th)
`(2 (info ,th)))
(define (necessite th r)
(memq? r (nec th)))
(define everything '(r0 r1 r2 a0 a1))
(define (modifie th r)
(memq? r (mod th)))
(define (empty-thunk)
(mthunk () (minfo () () ()) ()))
(define (empty-pthunk)
(mpthunk () (minfo () () ())))
(defmacro (mthunk c i s)
`(list 'thunk ,i ,c ,s))
(defmacro (mpthunk c i)
`(list 'thunk ,i ,c))
(define (add-source t s)
(mthunk (code t) (info t) s))
(define (add-strict v)
(mpthunk () (minfo () () (list v))))
(define (add-info n m s)
(mpthunk () (minfo n m s)))
;••• Fusion de 2 segments de code •••
(define (append2th t1 t2)
(mthunk (append (code t1)(code t2))
(minfo (union-set (nec t1)
(differ-set (nec t2)
(mod t1)))
(union-set (mod t1)
(mod t2))
(union-set (str t1)
(str t2)))
(append (source t1)
(source t2))))
(define (append2pth t1 t2)
(mpthunk (append (code t1)(code t2))
(minfo (union-set (nec t1)
(differ-set (nec t2)
(mod t1)))
(union-set (mod t1)
(mod t2))
(union-set (str t1)
(str t2)))))
;••• fusion de n segments de code •••
(define (appendths | ts)
(cond (null? ts) (empty-thunk)
(append2th (0 ts) (apply appendths (-1 ts)))))
(define (appendpths | ts)
(cond (null? ts) (empty-pthunk)
(append2pth (0 ts) (apply appendpths (-1 ts)))))
;••• alternative 2 partial thunks… les registres nec sont l'union des 2 •••
(define (undes2pth t1 t2)
(mpthunk (append (code t1)(code t2))
(minfo (union-set (nec t1)
(nec t2))
(union-set (mod t1)
(mod t2))
(inter-set (str t1)
(str t2)))))
;••• preserve le registre r si T1 le modifie et T2 necessite •••
(define (preservepth r t1 t2)
(cond (and (necessite t2 r)
(modifie t1 r))
(append2pth (addpushpop r t1) t2)
(append2pth t1 t2)))
(define (addpushpop r t)
(cond (memq? r '(d0 d1 lp)) (appendpths (synt-move "L" r '(- SP))
t
(synt-move "L" '(SP +) r))
(appendpths (synt-move "L" r '(LP +))
t
(synt-move "L" '(- LP) r))))
;••• Dummy thunks •••
(define thunk:getablock (mthunk () (minfo '(d0) '(a0) ()) 'GetABlock))
(define thunk:lookvarval (mthunk () (minfo '(r0 r2) '(r0) ()) 'LookVarVal))
(define thunk:valvarset (mthunk () (minfo '(a0 r0) '(m) ()) 'ValVarSet))
(define thunk:applyit (mthunk () (minfo '(d1) '(r0 r1 r2 a0 a1 d0 d1) ()) 'ApplyStack))
(define thunk:susp&apply (mthunk () (minfo '(d1) '(r0 r1 r2 a0 a1 d0 d1) ()) 'Suspend&Apply))
(define thunk:holda0 (mthunk () (minfo '(a0) '(r0 r1 r2 a1 d0 d1) ()) 'HoldA0))
(define thunk:holda1 (mthunk () (minfo '(a1) '(r0 r1 r2 a0 d0 d1) ()) 'HoldA1))
(define thunk:holdr0 (mthunk () (minfo '(r0) '(a0 r1 r2 a1 d0 d1) ()) 'HoldR0))